Класс моноидов

class  Monoid m  where
  mappend   :: m ­> m ­> m
  mempty :: m

  mconcat :: [m] -> m

Класс моноидов

mappend mempty x = x
mappend x mempty = x
mappend x (mappend y z) = mappend (mappend x y) z
mconcat = foldr mappend mempty

Класс моноидов

Data.Monoid

-- Списки
instance Monoid [a] where
mappend = (++)
Mempty = []

-- Числа
instance Monoid Integer where
mappend = (+)
Mempty = 0

instance Monoid Integer where
mappend = (*)
mempty = 1

Класс моноидов

-- Обёртки
Num a => Monoid (Sum a)

newtype Sum a = Sum { getSum :: a }
        deriving (Eq, Ord, Read, Show, Bounded)

Num a => Monoid (Product a)

newtype Product a = Product { getProduct :: a }
        deriving (Eq, Ord, Read, Show, Bounded)

mconcat [Sum 1, Sum 2, Sum 3, Sum 4] = Sum 10
-- На самом деле, Sum {getSum = 10}, но это неважно! newtype

mconcat [Product 1, Product 2, Product 3, Product 4] = [Product 24]

Класс моноидов (Writer)

newtype Writer w a = Writer { runWriter :: (a, w) }
-- В чём отличие data от newtype?

instance (Monoid w) => Monad (Writer w) where
  return x = Writer (x, mempty)
  (Writer (x,v)) >>= f =
    let (Writer (y, v')) = f x
    in Writer (y, v `mappend` v')

.:t tell
tell :: MonadWriter w m => w -> m ()

import Control.Monad.Writer
fact :: Integer -> Writer String Integer
fact 0 = return 1
fact n = do
  let n' = n-1
  tell $ show n ++ " - 1 \n"
  m <- fact n'
  tell $ "fact " ++ show m ++ "\n"
  let r = n*m
  tell $ show n ++ " * " ++ show m ++ "\n"
  return r

.:t runWriter
runWriter :: Writer w a -> (a, w)
putStr $ snd $ runWriter $ fact 10

import Control.Monad.Writer

fact2 :: Integer -> Writer (Sum Integer) Integer
fact2 0 = return 1
fact2 n = do
  let n' = n-1
  tell $ Sum 1
  m <- fact2 n'
  let r = n*m
  tell $ Sum 1
  return r

-- Первая лаба
putStr $ snd $ runWriter $ fact2 10

import Control.Monad.State

fact3 :: Integer -> State Integer Integer
fact3 0 = return 1
fact3 n = do
  let n' = n-1
  modify (+1)
  m <- fact3 n'
  let r = n*m
  modify (+1)
  return r

runState (fact3 10) 0

-- Writer понятнее

Ещё два моноида: Any, All

import Control.Monad.Writer

fact4 :: Integer -> Writer Any Integer
fact4 0 = return 1
fact4 n = do
  let n' = n-1
  m <- fact4 n'
  let r = n*m
  tell (Any (r==120))
  return r

> runWriter $ fact 2
> runWriter $ fact 10

Коммутативные, некоммутативные, двойные моноиды

(+), (++)
-- Законы моноидов

fact5 :: Integer -> Writer (Dual String) Integer
fact5 0 = return 1
fact5 n = do
  let n' = n-1
  tell $ Dual $ show n ++ " - 1\n"
  m <- fact5 n'
  tell $ Dual $ "fact " ++ show m ++ "\n"
  let r = n*m
  tell $ Dual $ show n ++ " * " ++ show m ++ "\n"
  return r

let Dual a = snd $ runWriter $ fact5 10
putStrLn a

Умножение моноидов

instance (Monoid a,Monoid b) => Monoid (a,b) where
    mempty = (mempty, mempty)
    mappend (u,v) (w,x) = (u `mappend` w,v `mappend` x)

Умножение моноидов

tellFst a = tell $ (a,mempty)
tellSnd b = tell $ (mempty,b)

fact6 :: Integer -> Writer (String,Sum Integer) Integer
fact6 0 = return 1
fact6 n = do
  let n' = n-1
  tellSnd (Sum 1)
  tellFst $ show n ++ " - 1 \n"
  m <- fact6 n'
  let r = n*m
  tellSnd (Sum 1)
  tellFst $ show n ++ " * " ++ show m ++ "\n"
  return r

Снова свёртки

import Data.Foldable

data Tree a = EmptyTree | Node a (Tree a) (Tree a)
  deriving (Show, Read)

instance Foldable Tree where
  foldMap f EmptyTree = mempty
  foldMap f (Node k l r) = foldMap f l `mappend` f k `mappend`
    foldMap f r

let tree = list2tree [1,4,6,8]

foldMap (Any . (== 1)) tree
foldMap (All . (> 5)) tree
foldMap (All . even) tree

Снова свёртки

Найти минимальный и максимальный элемент дерева, сконструировав моноид.

min, max
maxBound::Int, maxBound::Float, minBound::Bool
deriving Eq, Ord, Read, Show, Bounded

list2tree ([3,1,5,87,4]) :: (Num a, Ord a) => Tree a
list2tree ([3,1,5,87,4]::[Int]) :: Tree Int

foldMap ( ??? ) (tree::[Int])

Снова свёртки

newtype Max a = Max { getMax :: a }
        deriving (Eq, Ord, Read, Show, Bounded)

instance (Num a, Ord a, Bounded a) => Monoid (Max a) where
        mempty = minBound
        Max x `mappend` Max y = Max $ max x y

Итого

Интерфейс моноидов нужен для реализации алгоритмов, включая распараллеливание и поиск по дереву